#!/usr/sbin/perl
# $Id: surf-lib.pl,v 1.4 1997/01/28 22:31:44 beejay Exp $
#
# surf-lib.pl - perl library for Silicon Surf
#
#
#

if (!defined &__SURF_LIB__) {
    eval 'sub __SURF_LIB__ {1;}';

require('cgi-lib-g.pl') || die "can\'t load cgi-lib-g.pl: $!";

$ENV{'PATH'} = "/bin:/sbin:/usr/bin:/usr/sbin:/usr/bsd";

# Domains which have their own webmaster address.
@webmaster_domains = ("ca","fr","it","uk");

$DocumentRoot = "/www/silicon_surf";
# Get ServerRoot
chop($hostname = `hostname`);
$server_name = $ENV{'SERVER_NAME'} ? $ENV{'SERVER_NAME'} : $hostname;
$server_port = $ENV{'SERVER_PORT'} ? $ENV{'SERVER_PORT'} : 80;
($addr=`grep server_name /etc/hosts`) =~ s/\s+.*$//;
if ( -d "/usr/ns-home/httpd-${server_port}.$addr" ) {
    $ServerRoot = "/usr/ns-home/httpd-${server_port}.$addr";
} else {
    $ServerRoot = "/usr/ns-home/httpd-$server_port";
}
# Get magnus.conf info
open(MAGNUSCONF,"$ServerRoot/config/magnus.conf");
while(<MAGNUSCONF>) {
    chop;
    s/\#.*$//;			# Remove comments
    next if (/^\s*$/);		#  and strip blank lines

    ($option,$value) = split(/\s+/,$_,2);
    next if ($option eq "Init"); # Skip Init lines
    $MagnusConf{$option} = $value;
}
close(MAGNUSCONF);

# Get obj.conf info
open(OBJCONF,"$ServerRoot/config/obj.conf");
while(<OBJCONF>) {
    chop;
    if (/NameTrans/) {		# Name translation functions
	if (/fn=\"document-root\"/ ) { # Document Root
	    /^.*root=\"([^\"]*)\".*$/;
	    $DocumentRoot = $1;
	} elsif (/fn=\"unix-home\"/) {
	    ($from) = /from=\"([^\"]+)\"/;
	    ($dir) = /subdir=\"([^\"]+)\"/;
	    $NameTrans{$from} = $dir;
	    $NameTrans_type{$url} = "unix-home";
	} elsif (/fn=\"home-page\"/) {
	    /^.*path=\"([^\"]*)\".*$/;
	    $HomePage = $1;
	} elsif (/fn=\"pfx2dir\"/) { # Document alias
	    ($from) = /from=\"([^\"]+)\"/;
	    ($dir) = /dir=\"([^\"]+)\"/;
	    $NameTrans{$from} = $dir;
	    $NameTrans_type{$url} = "pfx2dir";
	} elsif (/fn=\"redirect\"/) { # Server redirect
	    ($from) = /from=\"([^\"]+)\"/;
	    if (/url-prefix=/) {
		($url) = /url-prefix=\"([^\"]+)\"/;
		$NameTrans_type{$url} = "redirect-prefix";
	    } else { 
		($url) = /url=\"([^\"]+)\"/;
		$NameTrans_type{$url} = "redirect";
	    }
	    $NameTrans{$url} = $dir;
	}
    }
    if (/<Object\s+.*ppath=\"([^\"]+)\"/) {
	($Object = $1) =~ s/\*/.*/g;	# Assign Object and make regexp
    }
    undef $Object if (/<\/Object>/);
    $AuthTrans{$Object} = $_	if ($Object && /^AuthTrans/);
    $PathCheck{$Object} = $_	if ($Object && /^PathCheck/);
}
close(OBJCONF);

########################################
# Check for authenticated path
#    path	- path relative to $DocumentRoot
# returns true if $path is part of an authenticated area
#
sub check_auth {
    local($path) = @_;
    local($AuthRealm);

    $path =~ s/^\///;		# Remove leading '/'
    $path =~ s/^\.\///;		#  or './'
    foreach $auth (keys %AuthTrans) {
	$rauth = &clean_regexp($auth);
	$rauth =~ s/\\\.\\\*/.*/g;	# Fix .* from config
	if ("$DocumentRoot/$path" =~ /$rauth/ && !$ENV{'AUTHORIZED'}) {
		($AuthRealm = $PathCheck{$auth}) =~ s/^.*realm=\"([^\"]+)\".*$/$1/;
		return($AuthRealm);
	}
    }
    0;
}

########################################
# Print standard document header
#    title      - document title (will also appear as H1 text)
#    titleimg   - if used, will display instead of H1 title (title will be
#                 ALT= text)
# Globals:
# 	$nomimeheader can be used to disable the Content-type header
#	$nobug will turn off the SGI logo
#	$ismap will set the header link to an imagemap
#
sub header {
    local ($title,$titleimg) = @_;
    
    &PrintMimeHeader()	unless($nomimeheader);
    print "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">\n" unless ($NoDoctype);
    print <<EOFEOF;
<HTML>
<HEAD>
<TITLE>$title</TITLE>
<LINK REV="made" HREF="mailto:webmaster\@www.sgi.com">
EOFEOF
foreach (@InHead) {
    print "$_\n";
}
print "</HEAD>\n";
    
    print "<BODY";
    $attr{'bgcolor'} = "#FFFFFF"	unless($attr{'bgcolor'});
    print " BGCOLOR=$attr{'bgcolor'} "	
	if ($attr{'bgcolor'} || $attr{'background'} =~ /\#[0-9a-f]{6}/i);
    print " BACKGROUND=$attr{'background'} "
	if ($attr{'background'} =~ /\.gif$/i);
    print " TEXT=$attr{'text'} "	if ($attr{'text'});
    print " LINK=$attr{'link'} "	if ($attr{'link'});
    print " VLINK=$attr{'vlink'} "	if ($attr{'vlink'});
    print " ALINK=$attr{'alink'} "	if ($attr{'alink'});
    print " $InBody "			if ($InBody);

    print ">\n";
    print "<IMG SRC=\"/Images/CorpID.gif\" ALT=\"Silicon Graphics, Inc.\"><BR>\n"	unless($nobug);
    print "<CENTER><P ALIGN=\"center\">\n"	if ($center);
    print "<IMG SRC=\"$attr{'headimg'}\" ALT=\"\"><BR>\n"
	if ($attr{'headimg'});
    print "<H1>";
    if ($titleimg) {
	# &getlang is a SurfZone thingie....
	print "<A HREF=\"$ismap\">"	if ($ismap);
	if ($domain && defined &getlang) {
	    print "<IMG SRC=\"$titleimg\" ALT=\"";
	    print &getlang($title);
	} else {
	    print "<IMG SRC=\"$titleimg\" ALT=\"$title\"";
	}
	print "\"";
	print " ISMAP"		if ($ismap);
	print " BORDER=\"$attr{'border'}\""	if (defined($attr{'border'}));
	print " HEIGHT=\"$attr{'height'}\""	if (defined($attr{'height'}));
	print " WIDTH=\"$attr{'width'}\""	if (defined($attr{'width'}));
	print ">";
	print "</A>"			if ($ismap);
    } else {
	if ($domain && defined &getlang) {
	    print &getlang($title);
	} else {
	    print "$title";
	}
    }
    print "</H1>\n";
    print "</P></CENTER>\n"	if ($center);
}

########################################
# Print standard document footer
# The following hidden variables may be imbedded in the form:
#   back_url            - URL back to form
#   back_url_image      - Image for back link
#   back_url_label      - Label for back link (will be ALT= text if image)
#   return_url          - URL to return to document
#   return_url_image    - Image for return link
#   return_url_label    - Label for return link (will be ALT= text if image)
# This will also print any icons for areas specified in PATH_INFO.
sub footer {
#    local($location) = @_;

#    $location = $ENV{'PATH_INFO'}	if (!$location);
#    print "<HR SIZE=\"6\">\n";
    print "<HR>\n";
    print "<A HREF=\"/\"><IMG SRC=\"/Images/Icon/surf.gif\"></A>\n";
    foreach $section (@sections) {
	$name{$section} = $section unless $name{$section};
        if ($icon_url{$section}) {
            print "<A HREF=\"$root{$section}\"><IMG SRC=\"$icon_url{$section}\" ALT=\"\[$name{$section}\]\"></A>\n";
        } elsif ($root{$section}) {
            print "<A HREF=\"$root{$section}\">[$name{$section}\]</A>\n";
	    
	}
    }
    if ($in{'back_url'}) {
        if ($in{'back_url_image'}) {
            print "<A HREF=\"$in{'back_url'}\"><IMG SRC=\"$in{'back_url_image'}\" ALT=\"$in{'back_url_label'}\"></A>\n";
        } else {
	    $in{'back_url_label'} = "[Back]" if (! $in{'back_url_label'});
            print "<A HREF=\"$in{'back_url'}\"><B>$in{'back_url_label'}</B></A>\n";
        }
    }
    if ($in{'return_url'}) {
        if ($in{'return_url_image'}) {
            print "<A HREF=\"$in{'return_url'}\"><IMG SRC=\"$in{'return_url_image'}\" ALT=\"$in{'return_url_label'}\"></A>\n";
        } else {
	    $in{'return_url_label'} = "[Return]" if (! $in{'return_url_label'});
            print "<A HREF=\"$in{'return_url'}\"><B>$in{'return_url_label'}</B></A>\n";
        }
    }
    print " <BR>\n";
    # &getlang is a SurfZone thingie....
    if ($domain && defined &getlang) {
	print "<FONT SIZE=\"-1\">";
	print &getlang("We welcome feedback and comments at");
	print "\n";
    } else {
	print "<FONT SIZE=\"-1\">We welcome feedback and comments at\n";
    }
    if ($domain && grep(/^$domain$/,@webmaster_domains)) {
	print "<A HREF=\"/cgi-bin/form_feedback/webmaster-$domain\@www.sgi.com?$domain\">webmaster-$domain\@www.sgi.com</A>. </FONT>\n";
    } else {
	print "<A HREF=\"/cgi-bin/form_feedback/webmaster\@www.sgi.com\">webmaster\@www.sgi.com</A>. </FONT>\n";
    }
    print "<P>\n";
    
    print "<FONT SIZE=\"-3\">";
    if ($domain && defined &getlang) {
	print &getlang("<A HREF=\"/Misc/sgi_info.html\">Copyright &#169; 1995, 1996, Silicon Graphics, Inc.</A>  All Rights Reserved");
	print &getlang("<A HREF=\"/Misc/external.list.html\">Trademark Information</A>");
    } else {
	print "<A HREF=\"/Misc/sgi_info.html\">Copyright &#169; 1995, 1996, Silicon Graphics, Inc.</A> All Rights Reserved";
	print "<A HREF=\"/Misc/external.list.html\">Trademark Information</A>";
    }
    print "</FONT>\n";
    print "</BODY>\n";
    print "</HTML>\n";
}

########################################
# Escape all regexp characters for matching
sub clean_regexp {
    local($regex) = @_;
    local($return);

    $regex =~ s/([\/()[\]*+|?.\{\}\\])/\\$1/g; # strip regexp
    $regex;
}

sub debug_print {
    local($level,$message) = @_;

    return	unless (defined($debug));
    return      if ($level > $debug);
    if ($nocr && ($olevel == $level)) {
        print STDERR "$message" if ($level <= $debug);
    } else {
        print STDERR "\n"       if ($nocr);
        print STDERR "DEBUG:$level:$message";
    }
    $olevel = $level;
    $nocr = $message !~ /\n/;
}

########################################
# Standard error handling
# input - array containing error message to print
sub surf_error {
    local(@error) = @_;
    
    &header("Error retrieving document!!","");
    
    foreach $line (@error) {
	print "$line";
    }
    print "<P>\n";
    
    &footer();
    
    exit 1;
}

########################################
# read_mimetypes - open and read the server mime.types file
#	put the results into %mime_types_ext and %mime_types_icon by extension
sub read_mimetypes {
    local($type,$ext,$icon);

    open(MIME,"$ServerRoot/config/mime.types");
    while (<MIME>) {
	chop;
	s/\#.*$//;
	next if (/^$/);
        ($type = $_) =~ s/^.*type=(\S+).*$/$1/;
        ($exts = $_) =~ s/^.*exts=(\S+).*$/$1/;
        ($icon = $_) =~ s/^.*icon=(\S+).*$/$1/;
	undef($icon)	unless (/icon=/);
        ($enc = $_) =~ s/^.*enc=(\S+).*$/$1/;
	undef($enc)	unless (/enc=/);
	foreach $ext (split(',',$exts)) {
	    if ($enc) {
		$mime_type_enc{$ext} = $enc;
	    } else {
		$mime_type_ext{$ext} = $type;
		$mime_type_icon{$ext} = $icon;
	    }
	}
    }
    close(MIME);
}

sub PrintMimeHeader {
    local($file) = @_;

    $file = "junk.html"	unless ($file); # Force HTML if no $file
    &read_mimetypes unless($mime_type_ext{"html"});

    ($ext = $file) =~ s/^.*\.([^\.]+)$/$1/;
    if ($mime_type_enc{$ext}) {
        $enc = $ext;
        ($ext = $file) =~ s/^.*\.([^\.]+)\.$enc$/$1/;
    }

    if (!$server) {
	$server = $server_name;
	$server .= ":$server_port" if ($server_port && $server_port ne "80");
    }

    # Send cookies if needed
    foreach $cookie (@cookies) {
	print "Set-Cookie:";
	print " ${cookie}=$cookie_value{$cookie};" if (defined($cookie_value{$cookie}));
	print " expires=$cookie_exp{$cookie};"	   if (defined($cookie_exp{$cookie}));
	print " path=$cookie_path{$cookie};"	   if (defined($cookie_path{$cookie}));
	print " domain=$cookie_domain{$cookie};"   if (defined($cookie_domain{$cookie}));
	print " secure"	       			   if (defined($cookie_secure{$cookie}));
	print "\n";
    }

    # Send redirection if needed
    if ($imagemap || $redirect) {
	$file =~ s/^\///;
	if ($redirect && $redirect =~ /https*:/) {
	    print "Location: $redirect\n";
	} else {
	    print "Location: http://$server/$file\n";
	}
    }

    # Send content encoding and type
    print "Content-encoding: $mime_type_enc{$enc}\n" if ($mime_type_enc{$enc});
    if ($mime_type_ext{$ext}) {
        print "Content-type: $mime_type_ext{$ext}\n";
    } else {
        print "Content-type: text/plain\n";
    }
    print "\n";
}

########################################
# Print a string, wrapping it to fit given width
#
sub wrap_print {
    local($handle,$string,$width) = @_;

    $pos = 0; $newend = $pos;
    while($pos < length($string)) {
	while($newend-$pos < $width) {
	    $end = $newend + 1;
	    $newend = index($string," ",$end);
	    $nl = index($string,"\n",$end);
	    if ($newend < 0) {
		print $handle substr($string,$pos,length($string)-$pos);
		print $handle "\n";
		return;
	    }
	    if (($nl > 0 && $newend > $nl) && $nl-$pos < $width) {
		$end = $nl + 1;
		last;
	    }
	}
	print $handle substr($string,$pos,$end-$pos);
	print $handle "\n";
	$pos = $end if ($end);
    }
}

########################################
# Return a file name for a given document (based at DocumentRoot)
# Returns both the "cleaned" filename, and the actual file pointed to
# if this is a link.
#
sub getfilename {
    local($baseurl) = @_;

    $baseurl =~ s/^\///;
    $baseurl = "." unless($baseurl);  # Current directory if null

    # Convert to index.html/cgi if directory
    if ($baseurl =~ /\/$/ || -d $baseurl) {
        $baseurl .= "/"    if ($baseurl !~ /\/$/);
        $baseurl .= "index.cgi" if (-f "$DocumentRoot/${baseurl}index.cgi" ||
				    -l "$DocumentRoot/${baseurl}index.cgi");
        $baseurl .= "index.html" if (-f "$DocumentRoot/${baseurl}index.html" ||
				     -l "$DocumentRoot/${baseurl}index.html");
    }
    $baseurl =~ s/^\.//;           # Remove leading "." (top of tree)

    if (! -f "$DocumentRoot/$baseurl" && ! -l "$DocumentRoot/$baseurl") {
        if (-d "$DocumentRoot/$baseurl") {
            print STDERR "ERROR: $baseurl contains no index file\n" unless($quiet);
        } else {
            print STDERR "ERROR: $baseurl not found\n"     unless($quiet);
            $baseurl = "";
        }
    }

    $lfile = "$DocumentRoot/$baseurl";
    while (-l "$lfile") {
	local($dirname,$basename);
	($dirname,$basename) = ($baseurl =~ (/^(.*)\/([^\/]*)$/));
        $lfile = readlink($lfile);
	if ($lfile !~ /^\//) {
            ($lfile = "$DocumentRoot/$dirname/$lfile") =~ s/\/\//\//g;
        }
        return("","")	unless (-f "$lfile" || -l "$lfile");
    }
    ($baseurl,$lfile);
}

}
1;
